/**
 * @file rmnl.h
 * @brief header files for the rmnl callable functions 
 * @author Wayne Zhang                         
 */

#ifndef RMM_H
#define RMM_H


#include "Matrix.h"

/** Stopping threshold in optimizing iterations */
#define RMM_EPS 1e-7
/** Stopping threshold in the MM iterations */
#define RMM_MM_EPS 5e-6
/** Minimum step factor in step halving */
#define RMM_SMIN 1e-5
/** Maximium iteration numbers in the coordinate descent step */
#define RMM_CDITER 200
/** Maximium iteration numbers in the Newton's step */
#define RMM_NRITER 200
/** A double null pointer */
#define RMM_DNULL ((double *) NULL)


/** positions in the dims vector */
enum RMM_DIM {
  nO_POS = 0,                  /**<number of rows of the sparse matrix */
  nB_POS,                      /**<number of columns of the sparse matrix */
  nP_POS,		       /**<number of purchase occasions */
  nC_POS,		       /**<number of alternatives */
  nG_POS,                      /**<number of groups */
  nL_POS,                      /**<number of lambdas */
  nI_POS,                      /**<number of individuals */
  nS_POS                       /**<number of segments */
};

/** positions in the control vector */
enum RMM_CTRL {
  llik_POS = 0,			/**<loglikelihood of the data */
  plik_POS,			/**<penalized loglikelihood including penalty */
  MMit_POS,                     /**<maximum # of iterations in the MM algorithm*/
  EMit_POS,                     /**<maximum # of iterations in the EM step*/
  new_POS,			/**<use Newton's update (only for mnl) */ 
  verb_POS,                     /**<verbose output ? */
  cvg_POS,                      /**<convergence indictor   */
  gam_POS,                      /**<penalty parameter in the group-lasso-ridge hybrid  */
  alp_POS,                      /**<penalty parameter in the elastic net  */
  tau_POS,                      /**<penalty parameter for the mixture   */
  lmr_POS,                      /**<lambda min ratio  */
  lms_POS,                      /**<lambda max scale  */       
  cst_POS,                      /**<whether to use contrast  */
  std_POS,                      /**<whether to orthonomalize the design  */
  eps_POS                       /**<stopping threshold used in the MM/EM algorithm  */
  //  int_POS,                      /**<indicator of whether the model has an intercept */
};


/**
 * Extract the slot named str from the object obj and return a null pointer
 * if the slot has length 0 or a pointer to the REAL contents.
 *
 * @param obj pointer to an S4 object
 * @param str pointer to a symbol naming the slot to extract
 *
 * @return pointer to the REAL contents, if nonzero length, otherwise
 * a NULL pointer
 *
 */
static R_INLINE double *SLOT_REAL_NULL(SEXP obj, char *str)
{
  SEXP pt = GET_SLOT(obj, install(str));
  return LENGTH(pt) ? REAL(pt) : (double*) NULL; 
}

/**
 * Extract the slot named str from the object obj and return a null pointer
 * if the slot has length 0 or a pointer to the INTEGER contents.
 *
 * @param obj pointer to an S4 object
 * @param str pointer to a symbol naming the slot to extract
 *
 * @return pointer to the INTEGER contents, if nonzero length, otherwise
 * a NULL pointer
 *
 */
static R_INLINE int *SLOT_INT_NULL(SEXP obj, char *str)
{
  SEXP pt = GET_SLOT(obj, install(str));
  return LENGTH(pt) ? INTEGER(pt) : (int*) NULL; 
}

/* When appropriate, alloca is cleaner than malloc/free.  The storage
 * is freed automatically on return from a function. When using gcc the
 * builtin version is much faster. */
#ifdef __GNUC__
# undef alloca
# define alloca(x) __builtin_alloca((x))
#else
/* this is necessary (and sufficient) for Solaris 10: */
# ifdef __sun
#  include <alloca.h>
# endif
#endif

/** alloca n elements of type t */
#define Alloca(n, t)   (t *) alloca( (size_t) ( (n) * sizeof(t) ) )

/**************************************************************
 *   The following extracts slots of an R sparse matrix      *
**************************************************************/

/** Return the integer pointer to the i slot (of an R sparse matrix)*/
#define SI_SLOT(x)  SLOT_INT_NULL(x, "i")

/** Return the integer pointer to the j slot (of an R sparse matrix)*/
#define SJ_SLOT(x)  SLOT_INT_NULL(x, "j")

/** Return the integer pointer to the p slot (of an R sparse matrix)*/
#define SP_SLOT(x)  SLOT_INT_NULL(x, "p")

/** Return the double pointer to the x slot (of an R sparse matrix)*/
#define SX_SLOT(x)  SLOT_REAL_NULL(x, "x")

/** Return the integer pointer to the p slot of the X slot */
#define XP_SLOT(x)  SP_SLOT(GET_SLOT(x, install("X")))

/** Return the integer pointer to the i slot of the X slot */
#define XI_SLOT(x)  SI_SLOT(GET_SLOT(x, install("X")))

/** Return the double pointer to the x slot of the X slot */
#define XX_SLOT(x)  SX_SLOT(GET_SLOT(x, install("X")))

/**************************************************************
 * The following extracts slots of an object of modelStruct  *
**************************************************************/

/** Return the double pointer to the X slot */
#define X_SLOT(x) GET_SLOT(x, install("X"))

/** Return the double pointer to the Xm slot */
#define Y_SLOT(x) SLOT_REAL_NULL(x, "y")

/** Return the integer pointer to the dims slot */
#define DIMS_SLOT(x) SLOT_INT_NULL(x, "dims")

/** Return the double pointer to the eta slot */
#define ETA_SLOT(x) SLOT_REAL_NULL(x, "eta")

/** Return the double pointer to the mu slot */
#define MU_SLOT(x) SLOT_REAL_NULL(x, "mu")

/** Return the double pointer to the resid slot */
#define RESID_SLOT(x) SLOT_REAL_NULL(x, "resid")

/** Return the double pointer to the resid slot */
#define WTS_SLOT(x) SLOT_REAL_NULL(x, "wts")

/** Return the double pointer to the beta slot */
#define BETA_SLOT(x) SLOT_REAL_NULL(x, "beta")

/** Return the double pointer to the hess slot */
#define HESS_SLOT(x) SLOT_REAL_NULL(x, "hess")

/** Return the double pointer to the control slot */
#define CTRL_SLOT(x) SLOT_REAL_NULL(x, "control")

/** Allocate (alloca) a cholmod_factor struct, populate it with values
 * from the L slot and return the pointer. */
#define L_SLOT(x) AS_CHM_FR(GET_SLOT(x, install("L")))

/** Return the integer pointer to the choice attribute of the y slot */
#define YI_SLOT(x) INTEGER(getAttrib(GET_SLOT(x, install("y")), install("nzero"))) 

/** Return the integer pointer to the gid slot */
#define GID_SLOT(x) SLOT_INT_NULL(x, "gid")

/** Return the integer pointer to the nalt attribute of the gid slot */
#define NALT_SLOT(x) INTEGER(getAttrib(GET_SLOT(x, install("gid")), install("nalt"))) 

/**************************************************************
 *    The following extracts slots of an object of glasso    *
**************************************************************/

/** Return the integer pointer to the gvar slot */
#define GVAR_SLOT(x) SLOT_INT_NULL(x, "gvar")

/** Return the integer pointer to the nvar attribute of the gvar slot */
#define NVAR_SLOT(x) INTEGER(getAttrib(GET_SLOT(x, install("gvar")), install("nvar"))) 

/** Return the double pointer to the pfct slot */
#define PFCT_SLOT(x) SLOT_REAL_NULL(x, "pfct")

/** Return the double pointer to the lambda slot */
#define LAM_SLOT(x) SLOT_REAL_NULL(x, "lambda")

/** Return the integer pointer to the subject slot */
#define SUB_SLOT(x) SLOT_INT_NULL(x, "subject")

/** Return the double pointer to the pi slot */
#define PI_SLOT(x) SLOT_REAL_NULL(x, "pi")

#endif
